COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE GEOMES
C00006 00003	
C00007 ENDMK
C⊗;
TITLE GEOMES
	.INSERT MN

SUBR($MORCOR)----------------------------------------------------
	ACCUMULATORS{PTR,SIZ}
	NODSIZ←←=12
;GET MORE CORE FROM SAIL - BGB - 8 MARCH 1972.
	PUSH P,PTR↔PUSH P,SIZ↔SETZ PTR,
L1:	MOVEI SIZ,NODSIZ*=400+1		;AC3 SIZE OF SPACE.
	CALL(@CORGET↑)			;AC2 ADDRESS OF SPACE.
	GO[FATAL(NO MORE CORE.)]↔SOS SIZ
	MOVSI(PTR)↔HRRI 1(PTR)↔SETZM(PTR) ;CLEAR 4K BLOCK OF MEMORY.
	BLT NODSIZ*=400-1(PTR)		  ;CLEAR 4K BLOCK OF MEMORY.
	LAC 1,PTR			  ;-3 WORD OF FIRST NODE.

;INITIALIZE THE UNIVERSE WHEN NECESSARY.
	SKIPE 2,UNIVER↑↔GO L3↔LAC 2,1
	ADDI 2,3↔DAC 2,UNIVERSE		;POINTER TO UNIVERSE NODE.
	MOVEI 2↔DAP @UNIVERSE		;UNIVERSE NODE IS TYPE #2.
L3:	MOVEI -1(2)↔DAC BLKCNT#		;POINTER TO NODES COUNTER.
	MOVEI  1(2)↔DAC AVAIL#		;POINTER TO AVAIL LIST.

;MAKE AVAIL LIST.
	DIP 1,1↔ADD 1,[XWD NODSIZ+3,3]		;XWD NEXT,,THIS
	SKIPN @BLKCNT↔GO[
	  ADD 1,[XWD NODSIZ,NODSIZ]     	;STEP OVER UNIVERSE.
	  AOS @BLKCNT↔SUBI SIZ,NODSIZ↔GO .+1]	;COUNT UNIVERSE NODE.
	SUBI SIZ,NODSIZ				;ALL BUT THE LAST.
	HRRZM 1,@AVAIL				;FIRST AVAIL NODE.

;PLACE EACH NEW EMPTY BLOCK ON THE AVAIL LIST.
L2:	HLRZM 1,1(1)↔AOS(1)		;EMPTY LIST POINTER & TYPE #1.
	ADD 1,[XWD NODSIZ,NODSIZ]
	SUBI SIZ,NODSIZ
	JUMPG SIZ,L2↔AOS(1)		;LAST AVAIL NODE.
	LAC 1,@AVAIL			;FIRST AVAIL NODE.
	POP P,3↔POP P,2↔POP0J
ENDR $MORCOR;------------------------------------------------------

CAR↑:	LAC 1,-1(P)↔CAR 1,(1)↔SUB P,[2(2)]↔GO@2(P)
CDR↑:	LAC 1,-1(P)↔CDR 1,(1)↔SUB P,[2(2)]↔GO@2(P)
DIP↑:	LAC -2(P)↔LAC 1,-1(P)↔DIP 0,(1)↔SUB P,[3(3)]↔GO@3(P)
DAP↑:	LAC -2(P)↔LAC 1,-1(P)↔DAP 0,(1)↔SUB P,[3(3)]↔GO@3(P)

END